home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol117 / creatord.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-15  |  3.8 KB  |  131 lines
  1. 90  WIDTH "scrn:", 80
  2. 95  SCREEN 0,1,0,0
  3. 100  TITLE$ = "Ordinances File Creation Program"
  4. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  5. 110  VERSION$ = "Version 3.0"
  6. 115  COPY1$ = "Copyright (c) 1983, 1984, 1985, by:"
  7. 120  COPY2$ = "Melvin O. Duke"
  8. 125  PRICE$ = "$35"
  9. 130  ADDR1$ = "Melvin O. Duke"
  10. 135  ADDR2$ = "P. O. Box 20836"
  11. 140  ADDR3$ = "San Jose, CA  95160"
  12. 145  REM Dimension Statements go here
  13. 170  REM Produce the first screen
  14. 175  KEY OFF : CLS
  15. 180  REM Draw the outer double box
  16. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  17. 190  REM Find the title location
  18. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  19. 200  REM Draw the title box
  20. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  21. 210  REM Print the title
  22. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  23. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  24. 225  REM Draw the Contribution box
  25. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  26. 235  REM Request the Contribution
  27. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  28. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  29. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
  30. 255  REM Draw the Mailing Label
  31. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  32. 265  REM Print the Name and Address
  33. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  34. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  35. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  36. 285  REM Draw the Copyright box
  37. 290  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 400
  38. 295  REM Print the Copyright
  39. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  40. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  41. 310  GOTO 740
  42. 400  REM subroutine to print a double box
  43. 405  COLOR 5
  44. 410  FOR I = R1 + 1 TO R2 - 1
  45. 420   LOCATE I, C1 : PRINT CHR$(186);
  46. 430   LOCATE I, C2 : PRINT CHR$(186);
  47. 440  NEXT I
  48. 450  FOR J = C1 + 1 TO C2 - 1
  49. 460   LOCATE R1, J : PRINT CHR$(205);
  50. 470   LOCATE R2, J : PRINT CHR$(205);
  51. 480  NEXT J
  52. 490   LOCATE R1, C1 : PRINT CHR$(201);
  53. 500   LOCATE R1, C2 : PRINT CHR$(187);
  54. 510   LOCATE R2, C1 : PRINT CHR$(200);
  55. 520   LOCATE R2, C2 : PRINT CHR$(188);
  56. 525  COLOR 7
  57. 530  RETURN
  58. 600  REM subroutine to print a single box
  59. 605  COLOR 3
  60. 610  FOR I = R1 + 1 TO R2 - 1
  61. 620   LOCATE I, C1 : PRINT CHR$(179);
  62. 630   LOCATE I, C2 : PRINT CHR$(179);
  63. 640  NEXT I
  64. 650  FOR J = C1 + 1 TO C2 - 1
  65. 660   LOCATE R1, J : PRINT CHR$(196);
  66. 670   LOCATE R2, J : PRINT CHR$(196);
  67. 680  NEXT J
  68. 690   LOCATE R1, C1 : PRINT CHR$(218);
  69. 700   LOCATE R1, C2 : PRINT CHR$(191);
  70. 710   LOCATE R2, C1 : PRINT CHR$(192);
  71. 720   LOCATE R2, C2 : PRINT CHR$(217);
  72. 725  COLOR 7
  73. 730  RETURN
  74. 740  REM ask user to press a key to continue
  75. 750  LOCATE 25,1
  76. 760  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  77. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  78. 780  CLS
  79. 800  REM Give the User one more chance to protect himself.
  80. 810  LOCATE 10,1
  81. 820  PRINT "This program creates an Ordinances-file by writing new, empty records."
  82. 830  PRINT "It will destroy any data which exists with the same record-numbers."
  83. 840  PRINT
  84. 850  PRINT "If this is REALLY what you want to do,"
  85. 860  PRINT "type  y  to continue, and press the return key."
  86. 870  PRINT "Otherwise, type anything else, and press the return key."
  87. 880  PRINT
  88. 890  INPUT "Enter your desired action.",REPLY$
  89. 900  IF REPLY$ <> "y" THEN 1400
  90. 1000  REM Ordinances File Creation Program
  91. 1010  REM By:  Melvin O. Duke.  Last Updated:  24 December 1984.
  92. 1020  OPEN "a:ordfile" AS #2 LEN = 256
  93. 1030  FIELD 2,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
  94. 1040  REM Write 400 Ordinances Records
  95. 1050  CLS
  96. 1060  FOR I = 1 TO 500
  97. 1070   TEMP = I
  98. 1080   LSET O1$ = MKS$(TEMP)
  99. 1090   TEMP = 0
  100. 1100   TEMP$ = " "
  101. 1110   LSET O2$ = TEMP$
  102. 1120   LSET O3$ = TEMP$
  103. 1130   LSET O4$ = TEMP$
  104. 1140   LSET O5$ = MKS$(TEMP)
  105. 1150   LSET O6$ = MKS$(TEMP)
  106. 1160   LSET O7$ = TEMP$
  107. 1170   LSET O8$ = TEMP$
  108. 1180   LSET O9$ = TEMP$
  109. 1190   LSET O10$ = TEMP$
  110. 1200   LSET O11$ = TEMP$
  111. 1210   LSET O12$ = MKS$(TEMP)
  112. 1220   LSET O13$ = TEMP$
  113. 1230   LSET O14$ = TEMP$
  114. 1240   LSET O15$ = TEMP$
  115. 1250   LSET O16$ = TEMP$
  116. 1260   LSET O17$ = TEMP$
  117. 1270   LSET O18$ = TEMP$
  118. 1280   LSET O19$ = TEMP$
  119. 1290   LSET O20$ = TEMP$
  120. 1300   LSET O21$ = TEMP$
  121. 1310   LSET O22$ = TEMP$
  122. 1320   LSET O23$ = TEMP$
  123. 1330   LSET O24$ = TEMP$
  124. 1340   LOCATE 23,1 : PRINT "Writing Record Number:";I
  125. 1350   PUT #2,I
  126. 1360  NEXT I
  127. 1370  CLOSE #2
  128. 1380  CLS : LOCATE 21,1
  129. 1390  PRINT "End of Program"
  130. 1400  RUN "a:menu"
  131.